home *** CD-ROM | disk | FTP | other *** search
- UNIT Graphics; { Intended at 16 color graphics unit }
-
- INTERFACE
-
- {╔═════════════════════════════════════════════════════════════════════════╗
- ║ Useful constants for modes & colors ║
- ╚═════════════════════════════════════════════════════════════════════════╝}
-
- CONST { HI nibble is mode number, LO is data }
- Vga640x480x016=$02; { 2 = 4 bit graphics mode }
- Ega640x200x016=$12;
- Ega640x350x016=$22;
- Txt080x025x016=$00; { 0 = textmode }
- Txt080x050x016=$10;
- Txt080xOwnFont=$20;
- UnknownGfxMode=$FF;
-
- ON =TRUE; OFF =FALSE;
-
- Black = 0; Blue = 1;
- Green = 2; Cyan = 3;
- Red = 4; Magenta = 5;
- Brown = 6; LightGray = 7;
- DarkGray = 8; LightBlue = 9;
- LightGreen = 10; LightCyan = 11;
- LightRed = 12; LightMagenta = 13;
- Yellow = 14; White = 15;
-
- None = 0; Left = 1;
- Right = 2; Both = 3;
-
- FourBitDac : ARRAY[0..15] OF BYTE=
- (0,1,2,3,4,5,20,7,56,57,58,59,60,61,62,63);
-
- {╔═════════════════════════════════════════════════════════════════════════╗
- ║ Objects for easier handling of larger graphical structures ║
- ╚═════════════════════════════════════════════════════════════════════════╝}
-
- TYPE Bob=OBJECT
- fore,back:ARRAY[0..23,0..23] OF BYTE;
- px,py,ignore:BYTE;
- PROCEDURE Clear;
- PROCEDURE SetFore(x,y:WORD);
- PROCEDURE GetFore(xa,ya,xb,yb:WORD; ig:BYTE);
- PROCEDURE SetBack(x,y:WORD);
- PROCEDURE GetBack(x,y:WORD);
- PROCEDURE Save(name:STRING);
- PROCEDURE Load(name:STRING);
- END;
-
- Button=OBJECT
- xa,ya,xb,yb:WORD; fg,bg,hl,sd:BYTE;
- title,oldtt:STRING; press:BOOLEAN;
- PROCEDURE Draw;
- PROCEDURE Remove;
- PROCEDURE Init(ax,ay,bx,by:WORD; f,b,h,s:BYTE; t:STRING);
- FUNCTION Quick(ms:WORD):BOOLEAN;
- FUNCTION Pressed:BOOLEAN;
- FUNCTION Switched:BOOLEAN;
- END;
-
- TextFrame=OBJECT
- xp,yp:WORD; tc,bh,bs,bk,sz:BYTE; data,what:STRING;
- PROCEDURE Draw;
- PROCEDURE Init(x,y:WORD; a,b,c,d,l:BYTE; s,t:STRING);
- FUNCTION Inside:BOOLEAN;
- PROCEDURE Remove(color:BYTE);
- END;
-
- {╔═════════════════════════════════════════════════════════════════════════╗
- ║ Important variables and settings ║
- ╚═════════════════════════════════════════════════════════════════════════╝}
-
- TYPE DACBUFFER=ARRAY[0..255,0..2] OF BYTE;
-
- VAR WhatGfxMode ,
- FontHeight ,
- MouseButtons :BYTE;
- VideoSegment ,
- xMax ,
- yMax ,
- FontSegment ,
- FontOffset ,
- MouseXpos ,
- MouseYpos :WORD;
- MouseBob :BOB;
- MouseHardWare ,
- MouseState :BOOLEAN;
- MouseHardBob :ARRAY[0..33] OF WORD;
-
- {╔═════════════════════════════════════════════════════════════════════════╗
- ║ General procedures, vital graphic procedures ║
- ╚═════════════════════════════════════════════════════════════════════════╝}
-
- FUNCTION GraphicsMode(mode:BYTE):BOOLEAN;
- PROCEDURE SetPix(x,y:WORD; color:BYTE);
- FUNCTION GetPix(x,y:WORD):BYTE;
- PROCEDURE Hline(xa,xb,y:WORD; color:BYTE);
- PROCEDURE Vline(x,ya,yb:WORD; color:BYTE);
- PROCEDURE Box(xa,ya,xb,yb:WORD; color:BYTE);
- PROCEDURE Fbox(xa,ya,xb,yb:WORD; color:BYTE);
- PROCEDURE Clear(color:BYTE);
- PROCEDURE Line(xa,ya,xb,yb:INTEGER; color:BYTE);
- PROCEDURE PutMap(x,y:WORD; VAR map:POINTER; ignore:BYTE);
- PROCEDURE GetMap(x,y:WORD; VAR map:POINTER);
-
- {╔═════════════════════════════════════════════════════════════════════════╗
- ║ Procedures for handling fonts, mostly based on pointers ║
- ╚═════════════════════════════════════════════════════════════════════════╝}
-
- FUNCTION MainFont(font:POINTER):POINTER; { leaves pointer to OLD mainfont }
- FUNCTION WhatFont:POINTER; { leaves pointer to THE mainfont }
- PROCEDURE PlotChar(x,y:WORD; ch,color,bg:BYTE);
- PROCEDURE DrawChar(x,y:WORD; ch,color:BYTE);
- PROCEDURE WriteLine(x,y:WORD; s:STRING; color,bg:BYTE);
-
- {╔═════════════════════════════════════════════════════════════════════════╗
- ║ DAC color controller procedures ║
- ╚═════════════════════════════════════════════════════════════════════════╝}
-
- PROCEDURE DacSetSingle(nr,red,green,blue:BYTE);
- PROCEDURE DacGetSingle(nr:BYTE; VAR red,green,blue:BYTE);
- PROCEDURE DacSetPalette(dac:DACBUFFER);
- PROCEDURE DacGetPalette(VAR dac:DACBUFFER);
- PROCEDURE DacSavePalette(name:STRING; dac:DACBUFFER);
- PROCEDURE DacLoadPalette(name:STRING; VAR dac:DACBUFFER);
-
- {╔═════════════════════════════════════════════════════════════════════════╗
- ║ Mouse routines with interrupt handling on $1C ║
- ╚═════════════════════════════════════════════════════════════════════════╝}
-
- PROCEDURE MouseSetArrowBob;
- PROCEDURE MouseSetClockBob;
- PROCEDURE MouseUseHardware;
- PROCEDURE MouseUseSoftware;
- FUNCTION MouseReset:BOOLEAN;
- PROCEDURE Mouse(mode:BOOLEAN);
- PROCEDURE MouseSetPosition(x,y:WORD);
- PROCEDURE MouseSetRange(xa,ya,xb,yb:WORD);
- FUNCTION MouseInitiateInterrupt:BOOLEAN;
- PROCEDURE MouseEndInterrupt;
-
- IMPLEMENTATION
-
- {╔═════════════════════════════════════════════════════════════════════════╗
- ║ Procedures only visible within this unit ║
- ╚═════════════════════════════════════════════════════════════════════════╝}
-
- VAR ScanCode:BYTE;
-
- FUNCTION InterruptVector(pntr:POINTER; itr:BYTE):POINTER;
- BEGIN
- ASM CLI END;
- InterruptVector:=Ptr(MemW[0:itr*4+2],MemW[0:itr*4]);
- MemW[0:itr*4]:=Ofs(pntr^); MemW[0:itr*4+2]:=Seg(pntr^);
- ASM STI END;
- END;
-
- FUNCTION KeyWaiting:BOOLEAN; ASSEMBLER;
- ASM
- MOV ax,$0040
- MOV es,ax
- MOV al,FALSE
- MOV bx,es:[$001A]
- CMP bx,es:[$001C]
- JE @qt
- MOV al,TRUE
- @qt:
- END;
-
- FUNCTION Len(stg:STRING):BYTE; ASSEMBLER;
- ASM
- LES di,stg
- MOV al,es:[di]
- END;
-
- FUNCTION GetKey:CHAR; ASSEMBLER; { with wait if no key }
- ASM
- MOV ax,$0040
- MOV es,ax
- @wt: MOV bx,es:[$001A]
- CMP bx,es:[$001C]
- JZ @wt
- MOV ax,es:[bx]
- MOV ScanCode,AH
- ADD bx,2
- CMP bx,es:[$0082]
- JB @nx { buffer not at end }
- MOV bx,es:[$0080]
- @nx: MOV es:[$001A],bx
- END;
-
- {╔═════════════════════════════════════════════════════════════════════════╗
- ║ Objects for easier handling of larger graphical structures ║
- ╚═════════════════════════════════════════════════════════════════════════╝}
-
- PROCEDURE Bob.Clear;
- BEGIN
- px:=0; py:=0; ignore:=0; fore[0,0]:=0; back[0,0]:=0;
- END;
-
- PROCEDURE Bob.SetFore(x,y:WORD);
- VAR a,b:BYTE;
- BEGIN
- FOR a:=0 TO px DO FOR b:=0 TO py DO
- IF fore[a,b]<>ignore THEN SetPix(x+a,y+b,fore[a,b]);
- END;
-
- PROCEDURE Bob.GetFore(xa,ya,xb,yb:WORD; ig:BYTE);
- VAR a,b:BYTE;
- BEGIN
- px:=xb-xa; py:=yb-ya; ignore:=ig;
- FOR a:=0 TO px DO FOR b:=0 TO py DO fore[a,b]:=GetPix(xa+a,ya+b);
- END;
-
- PROCEDURE Bob.SetBack(x,y:WORD);
- VAR a,b:BYTE;
- BEGIN
- FOR a:=0 TO px DO FOR b:=0 TO py DO SetPix(x+a,y+b,back[a,b]);
- END;
-
- PROCEDURE Bob.GetBack(x,y:WORD);
- VAR a,b:BYTE;
- BEGIN
- FOR a:=0 TO px DO FOR b:=0 TO py DO back[a,b]:=GetPix(x+a,y+b);
- END;
-
- PROCEDURE Bob.Save(name:STRING);
- VAR fil:FILE OF BYTE; a,b:BYTE;
- BEGIN
- Assign(fil,name);
- ReWrite(fil);
- Write(fil,px);
- Write(fil,py);
- Write(fil,ignore);
- FOR b:=0 TO py DO FOR a:=0 TO px DO Write(fil,fore[a,b]);
- Close(fil);
- END;
-
- PROCEDURE Bob.Load(name:STRING);
- VAR fil:FILE OF BYTE; a,b:BYTE;
- BEGIN
- Assign(fil,name);
- Reset(fil);
- Read(fil,px);
- Read(fil,py);
- Read(fil,ignore);
- FOR b:=0 TO py DO FOR a:=0 TO px DO Read(fil,fore[a,b]);
- Close(fil);
- END;
-
- {───────────────────────────────────────────────────────────────────────────}
-
- PROCEDURE Button.Draw;
- VAR a,b:BYTE; ms:BOOLEAN;
- BEGIN
- ms:=MouseState; Mouse(OFF);
- IF press THEN BEGIN a:=fg; fg:=sd; b:=hl; hl:=sd; sd:=b; END;
- Box(xa,ya,xb,yb,0);
- HLine(Xa+1,Xb-2,Ya+1,Hl); VLine(Xa+1,Ya+1,Yb-1,Hl);
- HLine(Xa+2,Xb-1,Yb-1,Sd); VLine(Xb-1,Ya+1,Yb-1,Sd);
- HLine(Xa+2,Xb-3,Ya+2,Hl); VLine(Xa+2,Ya+2,Yb-2,Hl);
- HLine(Xa+3,Xb-2,Yb-2,Sd); VLine(Xb-2,Ya+2,Yb-2,Sd);
- IF oldtt<>title THEN
- BEGIN
- Fbox(xa+3,ya+3,xb-3,yb-3,bg); oldtt:=title;
- END;
- WriteLine(xa+1+(xb-xa-Len(title)*8) DIV 2,
- ya+1+((yb-ya) DIV 2)-FontHeight DIV 2,title,fg,bg);
- IF press THEN BEGIN fg:=a; sd:=hl; hl:=b; END;
- Mouse(ms);
- END;
-
- PROCEDURE Button.Remove;
- VAR ms:BOOLEAN;
- BEGIN
- ms:=MouseState; Mouse(OFF);
- Fbox(xa,ya,xb,yb,bg);
- Mouse(ms);
- END;
-
- PROCEDURE Button.Init(ax,ay,bx,by:WORD; f,b,h,s:BYTE; t:STRING);
- BEGIN
- xa:=ax; ya:=ay; xb:=bx; yb:=by; press:=OFF; oldtt:='';
- fg:=f; bg:=b; hl:=h; sd:=s; title:=t;
- END;
-
- FUNCTION Button.Quick(ms:WORD):BOOLEAN;
- BEGIN
- Quick:=FALSE; IF MouseButtons=None THEN Exit;
- IF (MouseXpos>=xa) AND (MouseYpos>=ya) AND
- (MouseXpos<=xb) AND (MouseYpos<=yb) THEN
- BEGIN
- Quick:=TRUE;
- ASM
- MOV ax,1000
- MUL ms
- MOV cx,dx
- MOV dx,ax
- MOV ah,$86
- INT $15
- END;
- END;
- END;
-
- FUNCTION Button.Pressed:BOOLEAN;
- BEGIN
- Pressed:=FALSE; IF MouseButtons=None THEN Exit;
- IF (MouseXpos>=xa) AND (MouseYpos>=ya) AND
- (MouseXpos<=xb) AND (MouseYpos<=yb) THEN
- BEGIN
- press:=NOT press; Draw;
- REPEAT UNTIL MouseButtons=None;
- IF (MouseXpos>=xa) AND (MouseYpos>=ya) AND
- (MouseXpos<=xb) AND (MouseYpos<=yb) THEN Pressed:=TRUE;
- press:=NOT press; Draw;
- END;
- END;
-
- FUNCTION Button.Switched:BOOLEAN;
- BEGIN
- Switched:=FALSE; IF MouseButtons=None THEN Exit;
- IF (MouseXpos>=xa) AND (MouseYpos>=ya) AND
- (MouseXpos<=xb) AND (MouseYpos<=yb) THEN
- BEGIN
- press:=NOT press; Draw;
- REPEAT UNTIL MouseButtons=None;
- Switched:=TRUE;
- END;
- END;
-
- {───────────────────────────────────────────────────────────────────────────}
-
- PROCEDURE TextFrame.Draw;
- VAR ms:BOOLEAN;
- BEGIN
- ms:=MouseState; Mouse(OFF);
- Fbox(xp,yp,xp+6+8*sz+8*Len(what),yp+6+FontHeight,bk);
- Box (xp,yp,xp+6+8*sz+8*Len(what),yp+6+FontHeight,bs);
- WriteLine(xp+3,yp+3,what+data,tc,bk);
- Mouse(ms);
- END;
-
- PROCEDURE TextFrame.Init(x,y:WORD; a,b,c,d,l:BYTE; s,t:STRING);
- BEGIN
- xp:=x; yp:=y; tc:=a; bk:=b; bh:=c; bs:=d;
- sz:=l+1; what:=s; data:=t;
- END;
-
- FUNCTION TextFrame.Inside:BOOLEAN;
- VAR a,b:WORD; ms:BOOLEAN; c:CHAR;
- BEGIN
- a:=xp+6+8*(Len(what)+sz);
- b:=yp+6+FontHeight;
- IF (MouseXpos<xp) OR (MouseYpos<yp) OR
- (MouseXpos> a) OR (MouseYpos> b) THEN Exit;
- ms:=MouseState; Mouse(OFF);
- Box(xp,yp,xp+6+8*sz+8*Len(what),yp+6+FontHeight,bh);
- Hline(xp+3+8*(Len(what)+Len(data)),
- xp+3+8*(Len(what)+Len(data))+8,yp+FontHeight+3,tc);
- Mouse(ms);
- WHILE (MouseXpos>=xp) AND (MouseYpos>=yp) AND
- (MouseXpos<= a) AND (MouseYpos<= b) DO
- BEGIN
- IF KeyWaiting THEN
- BEGIN
- Mouse(OFF);
- Hline(xp+3+8*(Len(what)+Len(data)),
- xp+3+8*(Len(what)+Len(data))+8,yp+FontHeight+3,bk);
- c:=GetKey;
- CASE c OF
- #13: ;
- #9: ;
- #8: IF (Len(data)>0) THEN
- BEGIN
- data[Len(data)]:=' ';
- WriteLine(xp+3,yp+3,what+data,tc,bk);
- data:=Copy(data,1,Len(data)-1);
- END;
- ELSE IF (Len(data)<sz-1) THEN
- BEGIN
- data:=data+c;
- WriteLine(xp+3,yp+3,what+data,tc,bk);
- END;
- END;
- Hline(xp+3+8*(Len(what)+Len(data)),
- xp+3+8*(Len(what)+Len(data))+8,yp+FontHeight+3,tc);
- Mouse(ms);
- END;
- END;
- Mouse(OFF);
- Box(xp,yp,xp+6+8*sz+8*Len(what),yp+6+FontHeight,bs);
- Hline(xp+3+8*(Len(what)+Len(data)),
- xp+3+8*(Len(what)+Len(data))+8,yp+FontHeight+3,bk);
- Mouse(ms);
- END;
-
- PROCEDURE TextFrame.Remove(color:BYTE);
- VAR ms:BOOLEAN;
- BEGIN
- ms:=MouseState; Mouse(OFF);
- Box(xp,yp,xp+6+8*sz+8*Len(what),yp+6+FontHeight,color);
- Mouse(ms);
- END;
-
- {╔═════════════════════════════════════════════════════════════════════════╗
- ║ General procedures, vital graphic procedures ║
- ╚═════════════════════════════════════════════════════════════════════════╝}
-
- FUNCTION GraphicsMode(mode:BYTE):BOOLEAN; ASSEMBLER;
- ASM
- MOV al,mode
- CMP al,Vga640x480x016
- JE @ma
- CMP al,Ega640x200x016
- JE @mb
- CMP al,Ega640x350x016
- JE @mc
- CMP al,Txt080x025x016
- JE @md
- CMP al,Txt080xOwnFont
- JE @me
- MOV al,FALSE
- JMP @qt
- @ma: MOV WhatGfxMode,al
- MOV VideoSegment,$A000
- MOV xMax,639
- MOV yMax,479
- MOV ax,$0012
- INT $10
- MOV al,TRUE
- JMP @qt
- @mb: MOV WhatGfxMode,al
- MOV VideoSegment,$A000
- MOV xMax,639
- MOV yMax,199
- MOV ax,$000E
- INT $10
- MOV al,TRUE
- JMP @qt
- @mc: MOV WhatGfxMode,al
- MOV VideoSegment,$A000
- MOV xMax,639
- MOV yMax,349
- MOV ax,$0010
- INT $10
- MOV al,TRUE
- JMP @qt
- @md: MOV WhatGfxMode,al
- MOV VideoSegment,$B800
- MOV xMax,79
- MOV yMax,24
- MOV ax,$0003
- INT $10
- MOV al,TRUE
- JMP @qt
- @me: MOV WhatGfxMode,al
- MOV VideoSegment,$B800
- MOV xMax,79
- MOV ax,400
- DIV FontHeight
- MOV yMax,ax
- MOV ax,$0003
- INT $10
- PUSH bp
- MOV ax,$1110
- MOV es,FontSegment
- MOV bp,FontOffset
- MOV cx,$0100
- MOV dx,$0000
- MOV bh,es:[bp-1]
- MOV bl,$00
- INT $10
- POP BP
- MOV al,TRUE
- JMP @qt
- @qt:
- END;
-
- PROCEDURE SetPix(x,y:WORD; color:BYTE); ASSEMBLER;
- ASM
- MOV ax,x
- CMP ax,xMax
- JA @qt
- MOV ax,y
- CMP ax,yMax
- JA @qt
- MOV es,VideoSegment
- MOV ch,color
- MOV ax,80
- MUL y
- MOV bx,x
- MOV cl,bl
- SHR bx,3
- ADD bx,ax
- AND cl,7
- MOV ax,$8008
- SHR ah,cl
- MOV dx,$3CE
- OUT dx,ax
- MOV ax,$0205
- OUT dx,ax
- MOV al,es:[bx]
- MOV es:[bx],ch
- { MOV ax,$FF08
- OUT dx,ax
- MOV ax,$0005
- OUT dx,ax }
- @qt:
- END;
-
- FUNCTION GetPix(x,y:WORD):BYTE; ASSEMBLER;
- ASM
- MOV ax,80
- MUL y
- MOV si,x
- MOV cx,si
- SHR si,3
- ADD si,ax
- AND cl,7
- XOR cl,7
- MOV ch,1
- SHL ch,cl
- MOV ax,VideoSegment
- MOV es,ax
- MOV dx,$3CE
- MOV ax,(3 SHL 8)+4
- XOR bl,bl
- @la: OUT dx,ax
- MOV bh,es:[si]
- AND bh,ch
- NEG bh
- ROL bx,1
- DEC ah
- JGE @la
- MOV al,bl
- END;
-
- PROCEDURE Hline(xa,xb,y:WORD; color:BYTE); ASSEMBLER;
- ASM
- MOV es,VideoSegment
- MOV si,xa
- MOV di,y
- MOV ch,color
- @lp: MOV ax,80
- MUL di
- MOV bx,si
- MOV cl,bl
- SHR bx,3
- ADD bx,ax
- AND cl,7
- MOV ah,128
- SHR ah,cl
- MOV dx,$3CE
- MOV al,8
- OUT dx,ax
- MOV ax,$0205
- OUT dx,ax
- MOV al,es:[bx]
- MOV es:[bx],ch
- INC si
- CMP si,xb
- JBE @lp
- END;
-
- PROCEDURE Vline(x,ya,yb:WORD; color:BYTE); ASSEMBLER;
- ASM
- MOV es,VideoSegment
- MOV si,x
- MOV di,ya
- MOV ch,color
- @lp: MOV ax,80
- MUL di
- MOV bx,si
- MOV cl,bl
- SHR bx,3
- ADD bx,ax
- AND cl,7
- MOV ah,128
- SHR ah,cl
- MOV dx,$3CE
- MOV al,8
- OUT dx,ax
- MOV ax,$0205
- OUT dx,ax
- MOV al,es:[bx]
- MOV es:[bx],ch
- INC di
- CMP di,yb
- JBE @lp
- END;
-
- PROCEDURE Box(xa,ya,xb,yb:WORD; color:BYTE);
- BEGIN
- Hline(xa,xb,ya,color); Hline(xa,xb,yb,color);
- Vline(xa,ya,yb,color); Vline(xb,ya,yb,color);
- END;
-
- PROCEDURE Fbox(xa,ya,xb,yb:WORD; color:BYTE); ASSEMBLER;
- ASM
- MOV es,VideoSegment
- MOV si,xa
- MOV di,ya
- MOV ch,color
- @lp: MOV ax,80
- MUL di
- MOV bx,si
- MOV cl,bl
- SHR bx,3
- ADD bx,ax
- AND cl,7
- MOV ah,128
- SHR ah,cl
- MOV dx,$3CE
- MOV al,8
- OUT dx,ax
- MOV ax,$0205
- OUT dx,ax
- MOV al,es:[bx]
- MOV es:[bx],ch
- INC si
- CMP si,xb
- JBE @lp
- MOV si,xa
- INC di
- CMP di,yb
- JBE @lp
- END;
-
- PROCEDURE Clear(color:BYTE); ASSEMBLER;
- ASM
- MOV es,VideoSegment
- MOV si,0
- MOV di,0
- MOV ch,color
- @lp: MOV ax,80
- MUL di
- MOV bx,si
- MOV cl,bl
- SHR bx,3
- ADD bx,ax
- AND cl,7
- MOV ah,128
- SHR ah,cl
- MOV dx,$3CE
- MOV al,8
- OUT dx,ax
- MOV ax,$0205
- OUT dx,ax
- MOV al,es:[bx]
- MOV es:[bx],ch
- INC si
- CMP si,xMax
- JBE @lp
- MOV si,0
- INC di
- CMP di,yMax
- JBE @lp
- END;
-
- PROCEDURE Line(xa,ya,xb,yb:INTEGER; color:BYTE);
- VAR d,dx,dy,ai,bi,xi,yi,x,y:INTEGER;
- BEGIN
- IF (Abs(xb-xa)<Abs(yb-ya)) THEN
- BEGIN
- IF ya>yb THEN
- ASM
- MOV AX,ya
- MOV BX,yb
- MOV ya,BX
- MOV yb,AX
- MOV AX,xa
- MOV BX,xb
- MOV xa,BX
- MOV xb,AX
- END;
- IF (xb>xa) THEN Xi:=1 ELSE Xi:=-1;
- Dy:=yb-ya; Dx:=Abs(xb-xa); D:=Dx*2-Dy; Ai:=2*(Dx-Dy);
- Bi:=Dx*2; X:=xa; Y:=ya;
- IF (X>=0) AND (Y>=0) AND (X<=Xmax) AND (Y<=Ymax) THEN SetPix(X,Y,color);
- FOR Y:=ya+1 TO yb DO
- BEGIN
- IF (D>=0) THEN
- ASM
- MOV AX,X
- ADD AX,Xi
- MOV X,AX
- MOV AX,D
- ADD AX,Ai
- MOV D,AX
- END ELSE ASM
- MOV AX,D
- ADD AX,Bi
- MOV D,AX
- END;
- IF (X>=0) AND (Y>=0) AND (X<=Xmax) AND (Y<=Ymax) THEN SetPix(X,Y,color);
- END;
- END ELSE BEGIN
- IF (xa>xb) THEN
- ASM
- MOV AX,xa
- MOV BX,xb
- MOV xa,BX
- MOV xb,AX
- MOV AX,ya
- MOV BX,yb
- MOV ya,BX
- MOV yb,AX
- END;
- IF (yb>ya) THEN Yi:=1 ELSE Yi:=-1;
- Dx:=xb-xa; Dy:=Abs(yb-ya); D:=Dy*2-Dx; Ai:=2*(Dy-Dx);
- Bi:=Dy*2; X:=xa; Y:=ya;
- IF (X>=0) AND (Y>=0) AND (X<=Xmax) AND (Y<=Ymax) THEN SetPix(X,Y,color);
- FOR X:=xa+1 TO xb DO
- BEGIN
- IF (D>=0) THEN
- ASM
- MOV AX,Y
- ADD AX,Yi
- MOV Y,AX
- MOV AX,D
- ADD AX,Ai
- MOV D,AX
- END ELSE ASM
- MOV AX,D
- ADD AX,Bi
- MOV D,AX
- END;
- IF (X>=0) AND (Y>=0) AND (X<=Xmax) AND (Y<=Ymax) THEN SetPix(X,Y,color);
- END;
- END;
- END;
-
- PROCEDURE PutMap(x,y:WORD; VAR map:POINTER; ignore:BYTE); ASSEMBLER;
- ASM
- END;
-
- PROCEDURE GetMap(x,y:WORD; VAR map:POINTER); ASSEMBLER;
- ASM
- END;
-
- {╔═════════════════════════════════════════════════════════════════════════╗
- ║ DAC color controller procedures ║
- ╚═════════════════════════════════════════════════════════════════════════╝}
-
- PROCEDURE DacSetSingle(nr,red,green,blue:BYTE); ASSEMBLER;
- ASM
- MOV dx,$3C8
- MOV al,nr
- OUT dx,al
- MOV dx,$3C9
- MOV al,red
- OUT dx,al
- MOV al,green
- OUT dx,al
- MOV al,blue
- OUT dx,al
- END;
-
- PROCEDURE DacGetSingle(nr:BYTE; VAR red,green,blue:BYTE); ASSEMBLER;
- ASM
- MOV dx,$3C7
- MOV al,nr
- OUT dx,al
- MOV dx,$3C9
- LES di,red
- IN al,dx
- MOV es:[di],al
- LES di,green
- IN al,dx
- MOV es:[di],al
- LES di,blue
- IN al,dx
- MOV es:[di],al
- END;
-
- PROCEDURE DacSetPalette(dac:DACBUFFER); ASSEMBLER;
- ASM
- PUSH ds
- LDS si,dac
- MOV dx,$3C8
- MOV al,0
- MOV cx,768
- OUT dx,al
- INC dx
- REP OUTSB
- POP ds
- END;
-
- PROCEDURE DacGetPalette(VAR dac:DACBUFFER); ASSEMBLER;
- ASM
- LES dx,dac
- MOV ax,$1017
- MOV bx,$0000
- MOV cx,$0100
- INT $10
- END;
-
- PROCEDURE DacSavePalette(name:STRING; dac:DACBUFFER);
- VAR fil:FILE OF BYTE; t,u:BYTE;
- BEGIN
- Assign(fil,name); ReWrite(fil);
- FOR u:=0 TO 2 DO FOR t:=0 TO 255 DO Write(fil,dac[t,u]);
- Close(fil);
- END;
-
- PROCEDURE DacLoadPalette(name:STRING; VAR dac:DACBUFFER);
- VAR fil:FILE OF BYTE; t,u:BYTE;
- BEGIN
- Assign(fil,name); Reset(fil);
- FOR u:=0 TO 2 DO FOR t:=0 TO 255 DO Read(fil,dac[t,u]);
- Close(fil);
- END;
-
- {╔═════════════════════════════════════════════════════════════════════════╗
- ║ Procedures for handling fonts, mostly based on pointers ║
- ╚═════════════════════════════════════════════════════════════════════════╝}
-
- {$L Romans.Obj} PROCEDURE RomansFont; EXTERNAL;
-
- FUNCTION MainFont(font:POINTER):POINTER;
- BEGIN
- MainFont:=Ptr(FontSegment,FontOffset-1);
- FontSegment:=Seg(font^); FontOffset:=Ofs(font^)+1;
- FontHeight:=Mem[FontSegment:FontOffset-1];
- END;
-
- FUNCTION WhatFont:POINTER;
- BEGIN
- WhatFont:=Ptr(FontSegment,FontOffset-1);
- END;
-
- PROCEDURE PlotChar(x,y:WORD; ch,color,bg:BYTE);
- VAR a,b:BYTE;
- BEGIN
- IF (x<0) OR (y<0) OR (x>xMax-8) OR (y>yMax-FontHeight) THEN Exit;
- FOR a:=0 TO 7 DO FOR b:=0 TO FontHeight-1 DO
- IF Mem[FontSegment:FontOffset+ch*FontHeight+b] AND
- (128 SHR (a AND 7))=(128 SHR (a AND 7))
- THEN SetPix(x+a,y+b,color) ELSE SetPix(x+a,y+b,bg);
- END;
-
- PROCEDURE DrawChar(x,y:WORD; ch,color:BYTE);
- VAR a,b:BYTE;
- BEGIN
- IF (x<0) OR (y<0) OR (x>xMax-8) OR (y>yMax-FontHeight) THEN Exit;
- FOR a:=0 TO 7 DO FOR b:=0 TO FontHeight-1 DO
- IF Mem[FontSegment:FontOffset+ch*FontHeight+b] AND
- (128 SHR (a AND 7))=(128 SHR (a AND 7))
- THEN SetPix(x+a,y+b,color);
- END;
-
- PROCEDURE WriteLine(x,y:WORD; s:STRING; color,bg:BYTE);
- VAR a:BYTE;
- BEGIN
- FOR a:=1 TO Len(s) DO IF color=bg
- THEN DrawChar(x+(a-1)*8,y,Ord(S[a]),color )
- ELSE PlotChar(x+(a-1)*8,y,Ord(S[a]),color,bg);
- END;
-
- {╔═════════════════════════════════════════════════════════════════════════╗
- ║ Mouse routines with interrupt handling on $1C ║
- ╚═════════════════════════════════════════════════════════════════════════╝}
-
- VAR MouseOldInterrupt:POINTER;
- MouseX,MouseY:WORD;
-
- {$F+}
- PROCEDURE MouseInterrupt; INTERRUPT;
- BEGIN
- ASM
- MOV ax,$0003
- INT $33
- MOV MouseButtons,bl
- MOV MouseXpos,cx
- MOV MouseYpos,dx
- END;
- InLine($9C);
- IF NOT MouseHardWare AND ((MouseX<>MouseXpos) OR (MouseY<>MouseYpos)) AND
- (MouseState=ON) THEN WITH MouseBob DO
- BEGIN
- SetBack(MouseX,MouseY);
- MouseX:=MouseXpos;
- MouseY:=MouseYPos;
- GetBack(MouseX,MouseY);
- SetFore(MouseX,MouseY);
- END;
- END;
-
- {$F-}
-
- PROCEDURE MouseSetArrowBob;
- BEGIN
- WITH MouseBob DO
- BEGIN
- Ignore:=1; px:=7; py:=7;
- {********} Fore[0,0]:=00; Fore[1,0]:=00; Fore[2,0]:=00; Fore[3,0]:=00;
- Fore[4,0]:=00; Fore[5,0]:=00; Fore[6,0]:=00; Fore[7,0]:=00;
- {*-----* } Fore[0,1]:=00; Fore[1,1]:=15; Fore[2,1]:=15; Fore[3,1]:=15;
- Fore[4,1]:=15; Fore[5,1]:=15; Fore[6,1]:=00; Fore[7,1]:=01;
- {*----* } Fore[0,2]:=00; Fore[1,2]:=15; Fore[2,2]:=15; Fore[3,2]:=15;
- Fore[4,2]:=15; Fore[5,2]:=00; Fore[6,2]:=01; Fore[7,2]:=01;
- {*-----* } Fore[0,3]:=00; Fore[1,3]:=15; Fore[2,3]:=15; Fore[3,3]:=15;
- Fore[4,3]:=15; Fore[5,3]:=15; Fore[6,3]:=00; Fore[7,3]:=01;
- {*------*} Fore[0,4]:=00; Fore[1,4]:=15; Fore[2,4]:=15; Fore[3,4]:=15;
- Fore[4,4]:=15; Fore[5,4]:=15; Fore[6,4]:=15; Fore[7,4]:=00;
- {*-*---* } Fore[0,5]:=00; Fore[1,5]:=15; Fore[2,5]:=00; Fore[3,5]:=15;
- Fore[4,5]:=15; Fore[5,5]:=15; Fore[6,5]:=00; Fore[7,5]:=01;
- {** *-* } Fore[0,6]:=00; Fore[1,6]:=00; Fore[2,6]:=01; Fore[3,6]:=00;
- Fore[4,6]:=15; Fore[5,6]:=00; Fore[6,6]:=01; Fore[7,6]:=01;
- {* * } Fore[0,7]:=00; Fore[1,7]:=01; Fore[2,7]:=01; Fore[3,7]:=01;
- Fore[4,7]:=00; Fore[5,7]:=01; Fore[6,7]:=01; Fore[7,7]:=01;
- END;
- ASM
- MOV AX,SEG MouseHardBob
- MOV ES,AX
- MOV DI,OFFSET MouseHardBob
- MOV AX,0000000000000000b; STOSW
- MOV AX,0000000000000000b; STOSW
- MOV AX,0011111111111111b; STOSW { oo }
- MOV AX,0001111111111111b; STOSW { o o }
- MOV AX,0000111111111111b; STOSW { o o }
- MOV AX,0000011111111111b; STOSW { o o }
- MOV AX,0000001111111111b; STOSW { o o }
- MOV AX,0000000111111111b; STOSW { o o }
- MOV AX,0000000011111111b; STOSW { o o }
- MOV AX,0000000001111111b; STOSW { o o }
- MOV AX,0000000000111111b; STOSW { o o }
- MOV AX,0000000000011111b; STOSW { o ooooo }
- MOV AX,0000000111111111b; STOSW { o o o }
- MOV AX,0001000011111111b; STOSW { o o o o }
- MOV AX,0011000011111111b; STOSW { oo o o }
- MOV AX,1111100001111111b; STOSW { o o }
- MOV AX,1111100001111111b; STOSW { o o }
- MOV AX,1111110001111111b; STOSW { ooo }
- MOV AX,0000000000000000b; STOSW
- MOV AX,0100000000000000b; STOSW
- MOV AX,0110000000000000b; STOSW
- MOV AX,0111000000000000b; STOSW
- MOV AX,0111100000000000b; STOSW
- MOV AX,0111110000000000b; STOSW
- MOV AX,0111111000000000b; STOSW
- MOV AX,0111111100000000b; STOSW
- MOV AX,0111111110000000b; STOSW
- MOV AX,0111110000000000b; STOSW
- MOV AX,0110110000000000b; STOSW
- MOV AX,0100011000000000b; STOSW
- MOV AX,0000011000000000b; STOSW
- MOV AX,0000001100000000b; STOSW
- MOV AX,0000001100000000b; STOSW
- MOV AX,0000000000000000b; STOSW
- MOV ax,SEG MouseHardBob
- MOV es,ax
- MOV si,OFFSET MouseHardBob
- MOV bx,es:[si]
- MOV cx,es:[si+2]
- ADD si,4
- MOV dx,si
- MOV ax,$0009
- INT $33
- END;
- END;
-
- PROCEDURE MouseSetClockBob;
- BEGIN
- ASM
- MOV AX,SEG MouseHardBob
- MOV ES,AX
- MOV DI,OFFSET MouseHardBob
- MOV AX,0000000000000000b; STOSW
- MOV AX,0000000000000000b; STOSW
- MOV AX,1111100000111111b; STOSW
- MOV AX,1110000000001111b; STOSW
- MOV AX,1100000000000111b; STOSW
- MOV AX,1000000000000011b; STOSW
- MOV AX,1000000000000011b; STOSW
- MOV AX,0000000000000001b; STOSW
- MOV AX,0000000000000001b; STOSW
- MOV AX,0000000000000001b; STOSW
- MOV AX,0000000000000001b; STOSW
- MOV AX,0000000000000001b; STOSW
- MOV AX,1000000000000011b; STOSW
- MOV AX,1000000000000011b; STOSW
- MOV AX,1100000000000111b; STOSW
- MOV AX,1110000000001111b; STOSW
- MOV AX,1111100000111111b; STOSW
- MOV AX,1111111111111111b; STOSW
- MOV AX,0000000000000000b; STOSW
- MOV AX,0000011011000000b; STOSW
- MOV AX,0001011111010000b; STOSW
- MOV AX,0011111011111000b; STOSW
- MOV AX,0011111011111000b; STOSW
- MOV AX,0101111011110100b; STOSW
- MOV AX,0111111011111100b; STOSW
- MOV AX,0011110000011000b; STOSW
- MOV AX,0111111011111100b; STOSW
- MOV AX,0101111111110100b; STOSW
- MOV AX,0011111111111000b; STOSW
- MOV AX,0011111111111000b; STOSW
- MOV AX,0001011111010000b; STOSW
- MOV AX,0000011011000000b; STOSW
- MOV AX,0000000000000000b; STOSW
- MOV AX,0000000000000000b; STOSW
- MOV ax,SEG MouseHardBob
- MOV es,ax
- MOV si,OFFSET MouseHardBob
- MOV bx,es:[si]
- MOV cx,es:[si+2]
- ADD si,4
- MOV dx,si
- MOV ax,$0009
- INT $33
- END;
- END;
-
- PROCEDURE MouseUseHardware;
- VAR ms:BOOLEAN;
- BEGIN
- ms:=MouseState; Mouse(OFF); MouseHardware:=ON; Mouse(ms);
- END;
-
- PROCEDURE MouseUseSoftware;
- VAR ms:BOOLEAN;
- BEGIN
- ms:=MouseState; Mouse(OFF); MouseHardware:=OFF; Mouse(ms);
- END;
-
- FUNCTION MouseReset:BOOLEAN; ASSEMBLER;
- ASM
- MOV ax,$0000
- INT $33
- END;
-
- PROCEDURE Mouse(mode:BOOLEAN);
- BEGIN
- IF MouseState=mode THEN Exit; MouseState:=mode;
- IF MouseHardware THEN
- ASM
- MOV ax,$0001
- CMP mode,ON
- JE @nx
- MOV ax,$0002
- @nx: INT $33
- END
- ELSE
- BEGIN
- IF mode=ON THEN WITH MouseBob DO
- BEGIN
- MouseX:=MouseXpos;
- MouseY:=MouseYpos;
- GetBack(MouseX,MouseY);
- SetFore(MouseX,MouseY);
- END
- ELSE MouseBob.SetBack(MouseX,MouseY);
- END;
- END;
-
- PROCEDURE MouseSetPosition(x,y:WORD); ASSEMBLER;
- ASM
- MOV cx,x
- MOV dx,y
- MOV ax,$0004
- INT $33
- END;
-
- PROCEDURE MouseSetRange(xa,ya,xb,yb:WORD);
- BEGIN
- END;
-
- FUNCTION MouseInitiateInterrupt:BOOLEAN;
- BEGIN
- IF NOT MouseReset THEN BEGIN MouseInitiateInterrupt:=FALSE; Exit; END;
- IF MouseState=ON THEN Mouse(OFF);
-
- MouseOldInterrupt:=InterruptVector(@MouseInterrupt,$1C);
- IF MouseHardWare THEN MouseUseHardWare
- ELSE MouseUseSoftWare;
- MouseState:=OFF;
- MouseInitiateInterrupt:=TRUE;
- END;
-
- PROCEDURE MouseEndInterrupt;
- BEGIN
- InterruptVector(MouseOldInterrupt,$1C);
- END;
-
- BEGIN
- WhatGfxMode:=UnknownGfxMode;
- MainFont(@RomansFont);
- MouseState:=OFF;
- MouseHardWare:=ON;
- END.